perm filename M11A.F4[P11,LCS]1 blob
sn#341683 filedate 1978-03-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CPASS3 PASS 3 MAIN PROGRAM
C00012 ENDMK
C⊗;
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
C DATA SPECIFICATION
INTEGER PEAK
DIMENSION T(50),TI(50),ITI(50)
COMMON I(7500) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
DIMENSION IHD(1)
EQUIVALENCE (IHD,P(1))
CC******* DATA IIIRD/Z5EECE66D/
DATA IIIRD/976545367/
C SET I ARRAY =0 (7/10/69)
DATA I/7500*0/,I(4)/12800/
C**************
C INIALIZATION OF PIECE
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
I(7)=IIIRD
IP9=IP(9)
C****** SEE BLOCK DATA RE. SCALE FACTORS ********* IP(12)=2**8
PEAK=0
NRSOR=0
IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
REWIND NREAD
REWIND NWRITE
TYPE 401
ACCEPT 501 ,FLNM,IDSK
C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
CALL IFILE(21,FLNM)
IF(IDSK.NE.0)GO TO 601
CALL OFILE(23,'TEST')
GO TO 701
C//// CALL PUTFILE('TEST')
C IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (TEST.SND)
IDSK=0
IHD(1)="525252525252
IHD(2)=I(4)
C I(4)=SRATE
IHD(3)=0
C 0=12-BIT
C (4)NCHNS←1 OR 2
IHD(4)=I(8)+1
IF(IHD(4).EQ.0)IHD(4)=1
C (5)MAXAMP (FLTING PT.) (6)=NUM. OF SAMPLES
CC P(55)=PEAK
IHD(6)=0
CALL FASTOU(IHD,128)
C THE HEADER (SUCH AS IT IS)
GO TO 701
601 IDSK=-1
401 FORMAT(' TYPE FILE NAME'/)
501 FORMAT(A5,I)
C**** ABOVE FOR PDP10 IO ********
701 SCLFT=IP(12)
I(2)=IP(4)
MS1=IP(7)
MS3=MS1+(IP(8)*IP(9))-1
MS2=IP(8)
I(4)=IP(3)
MOUT=IP(10)
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 I(N1)=-1
DO 221N1=1,IP9
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALLERROR(1)
GO TO 204
202 IF(IP(1)-IOP)201,203,203
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
GO TO 204
3 IGEN=P(3)
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
CCC 283 CALLGEN3
CCC GO TO 204
CCC 284 CALLGEN4
CCC GO TO 204
CCC 285 CALLGEN5
CCC GO TO 204
4 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)*SCLFT
GO TO 204
6 CALL FROUT3(IDSK)
STOP
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
230 IF(I(N1).EQ.-1)GO TO 231
CALLERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
TYPE 1230,IP(9)
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+IP(8)-1
DO 232N1=M1,M2
M5=N1-M1+1
232 I(N1)=P(M5)*SCLFT
I(M1 )=P(3)
DO 233N1=M3,M4
233 I(N1)=0
DO 235N1=1,IP9
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALLERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I(2)
M2=IP(5)+IFIX(P(3))
I(M2)=M1
218 CALL DATA (NREAD)
IF(I(1)-2)210,210,211
210 I(M1)=0
I(2)=M1+1
GO TO 204
211 I(M1)=P(3)
M3=I(1)
I(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 I(M1)=-IP(2)+(M5+101)*IP(6)
GO TO 216
301 I(M1)=-IP(13)+(M5+1)*IP(14)
GO TO 216
213 IF(M5- 100 )214,214,215
214 I(M1)=M5
GO TO 216
215 I(M1)=M5+26262
CCC 215 I(M1)=M5+262144
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T(2)=P(2)
250 TMIN=90909.
IREST=1
DO 241N1=1,IP9
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T(2))245,245,246
245 T(3)=TMIN
GO TO 260
246 T(3)=T(2)
GO TO 260
247 IF(T(1)-T(2))249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
I(M2)=-1
GO TO 250
C SETUP REST
251 T(3)=T(2)
IREST=2
GO TO 260
C PLAY
260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5
T(1)=T(3)
IF(ISAM)247,247,266
266 IF(ISAM-IP(14))262,262,263
262 I(5)=ISAM
ISAM=0
GO TO 264
263 I(5)=IP(14)
ISAM=ISAM-IP(14)
264 IF(I(8))290,290,291
290 M3=MOUT+I(5)-1
MSAMP=I(5)
GO TO 292
291 M3=MOUT+(2*I(5))-1
MSAMP=2*I(5)
292 DO 267N1=MOUT,M3
267 I(N1)=0
GO TO (268,265),IREST
268 DO 270NS1=MS1,MS3,MS2
IF(I(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=IP(5)+I(NS1)
IGEN=I(IGEN)
272 I(6)=IGEN
CC***** IF(I(IGEN)-101)293,294,294
CC***** 293 CALLSAMGEN(I)
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC***** GO TO 295
294 CALLFORSAM
295 IGEN=I(IGEN+1)
IF(I(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END